home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor1 / sunrset.src < prev    next >
Text File  |  1990-10-18  |  2KB  |  89 lines
  1. %%HP: T(3)A(D)F(.);
  2. @ by Charles Kluepfel
  3.    DIR
  4.       SRSS
  5.         \<< "Alt " ALT \->STR + 2 DISP ANLMA "Lat " LAT \->STR + " Dlo " +
  6.           DLONG \->STR + 1 DISP DLONG + \-> D EQT
  7.           \<< 'ACOS(( SIN(ALT)-SIN(LAT)* SIN(D))/(COS(LAT)* COS(D)))' EVAL
  8.             \-> HA
  9.             \<< EQT HA - D\->T EQT HA + D\->T AKEY DROP
  10.             \>>
  11.           \>>
  12.         \>>
  13.       ANLMA
  14.         \<< \-> MO DA
  15.           \<< DEG DAT 1 MO PUTI DA PUT LIST\-> DROP INDAT JD 2451545 -
  16.             .98564733 * DUP 280.47 + SWAP 2.47 - \-> RAMS M
  17.             \<< 'RAMS +1.91*SIN(M)' EVAL RAMS \->DRA
  18.             \>>
  19.           \>>
  20.         \>>
  21.       INDAT
  22.         \<< 3 \->LIST DUP \->JD DUP 'JD' STO J\->DOW SWAP 1 GETI 3 ROLLD GET
  23.           \-> DW M D
  24.           \<<
  25.             IF M 4 > M 10 < AND M 4 == D DW \>= AND OR M 10 == D 23 DW + \<=
  26.               AND OR
  27.             THEN DL1 'DLONG' STO
  28.             ELSE DL0 'DLONG' STO
  29.             END
  30.           \>>
  31.         \>>
  32.       GC 13
  33.       LAT 40.75
  34.       DL0 -1
  35.       DL1 14
  36.       ALT -.75
  37.       JD 2448248
  38.       DLONG -1
  39.       DAT
  40.         \<< JD JD\->
  41.         \>>
  42.       \->DRA
  43.         \<< \-> L RAMS
  44.           \<< 'ASIN( SIN(L)*.397)' EVAL \-> D
  45.             \<< 'ACOS (COS(L)/COS(D))' EVAL L SIN SGN * RAMS - NOR D SWAP
  46.             \>>
  47.           \>>
  48.         \>>
  49.    \->JD
  50.      \<< 1 3 SUB LIST\-> DROP \-> M D Y
  51.        \<< Y M
  52.          IF M 2 \<=
  53.          THEN 12 + SWAP 1 - SWAP
  54.          END 1 + 30.6001 * IP SWAP DUP 100 / FLOOR DUP 4 / FLOOR - 2 - 'GC' STO
  55.            365.25 * FLOOR + D + GC - 1720995 +
  56.       \>>
  57.     \>>
  58.   JD\->
  59.     \<< \-> JD
  60.       \<< JD 1867216.25 - 36524.25 / FLOOR DUP 4 / FLOOR - 1 + 'GC' STO JD GC +
  61.         1524 + \-> B
  62.         \<< 'FLOOR((B -122.1)/365.25)' EVAL \-> C
  63.           \<< 'FLOOR( 365.25*C)' EVAL \-> D
  64.             \<< ' FLOOR((B-D)/30.6001 )' EVAL \-> E
  65.               \<< IF E 13 \<= THEN E 1 - ELSE E 13 - END B D - E 30.6001 *
  66.                 FLOOR - IF OVER 3 \>= THEN C 4716 - ELSE C 4715 - END 3 \->LIST
  67.               \>>
  68.             \>>
  69.           \>>
  70.         \>>
  71.       \>>
  72.     \>>
  73.  AKEY \<<
  74.      DO KEY
  75.      UNTIL 0 \=/
  76.      END \>>
  77.  J\->DOW
  78.    \<< 1 + 7 MOD 1 + \>>
  79.  D\->T
  80.    \<< 4 * 720.5 + FLOOR 60 QREM 100 + STD \->STR 2 3 SUB SWAP \->STR 58 CHR +
  81.      SWAP +
  82.    \>>
  83.  QREM \<< DUP2 / FLOOR ROT ROT MOD \>>
  84.  NOR
  85.    \<< 1 ASIN 2 * DUP DUP 2 * SWAP 4 ROLL + SWAP MOD SWAP - \>>
  86.  SGN
  87.    \<< SIGN .5 + SIGN \>>
  88. END
  89.